-- modified from code by Remco Niemeijer 
module PrimQC where 
import List
import Test.QuickCheck
import Data.Char
	 
minim :: (Ord b) => (a -> b) -> [a] -> a
minim f = head . (sortBy (\ x y -> compare (f x) (f y)))

prim :: (Eq a, Ord b) => [(a, a, b)] -> [(a, a, b)]
prim es = f [(\(v,_,_) -> v) $ head es] [] where
  f vs t = if null r then t else f (union vs [x,y]) (m:t) where
    r = filter (\(a,b,_) -> elem a vs /= elem b vs) es
    m@(x,y,_) = minim (\(_,_,c) -> c) r

main :: IO ()
main = print $ prim [('A', 'D',  5), ('A', 'B', 7), ('B', 'D', 9)
                    ,('B', 'C',  8), ('C', 'E', 5), ('B', 'E', 7)
                    ,('D', 'E', 15), ('D', 'F', 6), ('E', 'F', 8)
                    ,('F', 'G', 11), ('E', 'G', 9)]

-- preparation for QuickCheck tests

prim' :: (Eq a, Ord b) => [(a, a, b)] -> [(a, a, b)]
prim' es = f [(\(v,_,_) -> v) $ head es] [] where
  f vs t = if null r then t else f (union vs [x,y]) (m:t) where
    r = filter (\(a,b,_) -> elem a vs /= elem b vs) es
    m@(x,y,_) = head r


data Graph = G [(Char,Char,Int)] deriving Show

instance Arbitrary Graph where 
    arbitrary =  
       frequency [(1, return (G [])), 
                  (2, do i <- choose (65, 75)
                         j <- choose (65, 75)
                         k <- choose (1,20)
                         (G ts) <- arbitrary 
                         return (G ((chr i, chr j, k):ts)))]

makeGr :: Eq a => [(a,a,b)] -> [(a,a,b)]
makeGr = nubBy  (\(x,y,_) -> \ (u,v,_) -> x==u && y ==v) .  
         filter (\(u,v,_) -> u /= v)

makeSym :: [(a,a,b)] -> [(a,a,b)]
makeSym gr = gr ++ invert gr where 
   invert :: [(a,a,b)] -> [(a,a,b)]
   invert = map (\(x,y,z) -> (y,x,z))


sumG :: [(a,a,Int)] -> Int
sumG = sum . (map  (\ (_,_,n) -> n))

nodes :: (Eq a,Ord a) => [(a,a,b)] -> [a]
nodes = nub.sort.nds where 
  nds = foldr (\ (x,y,_) -> ([x,y]++)) [] 

isSpanning :: Eq a => [a] -> [(a,a,b)] -> Bool
isSpanning xs [] = length xs <= 1
isSpanning xs ((y,z,_):ys) = 
     elem y xs && elem z xs && 
     (isSpanning (xs\\[y]) ys  || isSpanning (xs\\[z]) ys)

isTree :: [(Char,Char,Int)] -> Bool
isTree xs = isSpanning (nodes xs) xs

isConnected ::(Ord a, Ord b) => [(a, a, b)] -> Bool
isConnected xs = nodes (prim' xs) == nodes xs

-- some QuickCheck properties 

prop_istree :: Graph -> Bool
prop_istree (G xs) = isTree $ prim $ makeGr xs

prop_minimal :: Graph -> Bool
prop_minimal (G xs) = sumG (prim $ makeGr xs) <= sumG (prim' $ makeGr xs)

prop_reverse :: Graph -> Bool
prop_reverse (G xs) = 
  sumG (prim $ makeGr xs) == sumG (prim $ reverse $ makeGr xs)
-- fails for unconnected graphs 

prop_reverse2 :: Graph -> Property 
prop_reverse2 (G xs) = 
 isConnected xs ==> sumG (prim $ makeGr xs) == sumG (prim $ reverse $ makeGr xs)

prop_isspanning :: Graph -> Bool
prop_isspanning (G xs) = isSpanning (nodes xs) $ prim $ makeGr xs
-- fails for unconnected graphs 

prop_isspanning2 :: Graph -> Property
prop_isspanning2 (G xs) = 
  isConnected xs' ==> isSpanning (nodes xs') $ prim $ xs'
      where xs' = makeGr xs
